home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
FILEMENU.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-11
|
12KB
|
305 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
TYPE FileName
Arf AS STRING * 12 ' because TYPE is still pretty brain-dead
END TYPE
DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
DECLARE SUB Delay18th (BYVAL WaitTime%)
DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB FileSort (Array() AS FileName, Elements%)
DECLARE SUB FindFirstFx (Buffer$, FileName$, BYVAL FAttr%, ErrCode%)
DECLARE SUB FindNextFx (Buffer$, ErrCode%)
DECLARE FUNCTION GetAttrFx% (Buffer$)
DECLARE FUNCTION GetCRT2% ()
DECLARE FUNCTION GetEGA2% ()
DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
DECLARE SUB GetMouseLoc (Row%, Column%)
DECLARE FUNCTION GetNameFx$ (Buffer$)
DECLARE FUNCTION GetVGA2% ()
DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
DECLARE SUB MMButton (LeftB%, RightB%)
DECLARE SUB MMCursorOff ()
DECLARE SUB MMCursorOn ()
DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
SUB FileMenu (Mouse%, FileSpec$, SeekAttr%, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, FileListAttr%, HiliteAttr%, TitleAttr%, Title$, Grow%, Shade%)
CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
IF Visible% THEN LOCATE , , 0
MaxFile% = 2048 ' 2,048 files should be plenty (!)
DIM File(1 TO MaxFile%) AS FileName
GetVidMode VMode%, Cols%, Page% ' use active display page
IF GetCRT2% THEN ' use fast display unless CGA
IF GetEGA2% OR GetVGA2% THEN
Fast% = -1
ELSE
Fast% = 0
END IF
ELSE
Fast% = -1
END IF
RightCol% = LeftCol% + 13 ' set right column
Rows% = BottomRow% - TopRow% + 1 ' and number of rows
IF Shade% THEN
CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
ELSE
CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
END IF
DIM SavedScreen%(Words%)
'--- load file list
LastFile% = 0
Buffer$ = SPACE$(64)
FindFirstFx Buffer$, FileSpec$, ABS(SeekAttr%), ErrCode%
DO UNTIL ErrCode%
tmp% = GetAttrFx%(Buffer$)
IF SeekAttr% >= 0 OR (SeekAttr% < 0 AND ((tmp AND 31) = -SeekAttr)) THEN
IF LastFile% < MaxFile% THEN
LastFile% = LastFile% + 1
IF tmp% AND 16 THEN ' capitalize subdirectories
File(LastFile%).Arf = UCASE$(GetNameFx$(Buffer$))
ELSE ' normal files get lowercase treatment
File(LastFile%).Arf = LCASE$(GetNameFx$(Buffer$))
END IF
ELSE
ErrCode% = -1
END IF
END IF
IF ErrCode% = 0 THEN FindNextFx Buffer$, ErrCode%
LOOP
FileSort File(), LastFile%
TopRec% = 1
HiliteRow% = 1
'--- save the screen
IF Mouse% THEN MMCursorOff
DSeg% = VARSEG(SavedScreen%(1))
DOfs% = VARPTR(SavedScreen%(1))
IF Shade% THEN
DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
ELSE
DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
END IF
UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleAttr%, Title$, Page%, Fast%
IF Mouse% THEN MMCursorOn
GOSUB DisplayFiles
DO
'--- get input from appropriate device(s)
IF LeftButton% THEN Delay18th 1
DO
IF Mouse% THEN MMButton LeftButton%, RightButton%
IF LeftButton% = 0 AND RightButton% = 0 THEN
BIOSInkey AsciiCode%, ScanCode%
END IF
LOOP UNTIL LeftButton% OR RightButton% OR AsciiCode% OR ScanCode%
'--- handle mouse input, if any
IF Mouse% THEN
IF RightButton% THEN
AsciiCode% = 27
ELSEIF (LastFile% < 1) AND LeftButton% THEN
AsciiCode% = 27
ELSEIF LeftButton% THEN
GetMouseLoc MouseRow%, MouseCol%
IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
IF MouseCol% = RightCol% + 1 THEN
tmp% = SCREEN(MouseRow%, MouseCol%)
IF tmp% = 24 THEN
' convert to ^E (same as up arrow)
AsciiCode% = 5
ELSEIF tmp% = 25 THEN
' convert to ^X (same as down arrow)
AsciiCode% = 24
END IF
ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
IF MouseRow% - TopRow% + TopRec% <= LastFile% THEN
HiLiteRow% = MouseRow% - TopRow% + 1
AsciiCode% = 13
END IF
END IF
END IF
END IF
END IF
'--- handle keyboard input, if any
IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
IF AsciiCode% = 17 THEN ' ^Q WordStar key combo processing
GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
SELECT CASE AsciiCode%
CASE 3 ' ^QC converts to ^<PgDn>
AsciiCode% = 0
ScanCode% = 118
CASE 18 ' ^QR converts to ^<PgUp>
AsciiCode% = 0
ScanCode% = 132
CASE ELSE
AsciiCode% = 0
ScanCode% = 0
END SELECT
END IF
IF AsciiCode% = 0 AND ScanCode% = 71 THEN
' <HOME>
IF HiliteRow% > 1 THEN
HiliteRow% = 1
GOSUB DisplayFiles
END IF
ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
' <END>
IF TopRec% + Rows% > LastFile% THEN
HiliteRow% = LastFile% - TopRec% + 1
ELSE
HiliteRow% = Rows%
END IF
GOSUB DisplayFiles
ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
' <CTRL><PGDN>
TopRec% = LastFile% - Rows% + 1
IF TopRec% < 1 THEN TopRec% = 1
IF TopRec% + Rows% > LastFile% THEN
HiliteRow% = LastFile% - TopRec% + 1
ELSE
HiliteRow% = Rows%
END IF
GOSUB DisplayFiles
ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
' <CTRL><PGUP>
IF TopRec% > 1 OR HiliteRow% > 1 THEN
TopRec% = 1
HiliteRow% = 1
GOSUB DisplayFiles
END IF
ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
' ^C or PgDn
IF TopRec% + 2 * Rows% - 1 < LastFile% THEN
TopRec% = TopRec% + Rows%
ELSE
TopRec% = LastFile% - Rows% + 1
IF TopRec% < 1 THEN TopRec% = 1
END IF
IF TopRec% > LastFile% THEN TopRec% = LastFile%
IF TopRec% + HiliteRow% - 1 >= LastFile% THEN
HiliteRow% = LastFile% - TopRec% + 1
END IF
GOSUB DisplayFiles
ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
' ^E or up arrow
IF HiliteRow% > 1 OR TopRec% > 1 THEN
IF HiliteRow% > 1 THEN
HiliteRow% = HiliteRow% - 1
ELSE
TopRec% = TopRec% - 1
END IF
GOSUB DisplayFiles
END IF
ELSEIF AsciiCode% = 13 THEN
' <CR>
IF LastFile% < 1 THEN
AsciiCode% = 27
LemmeOuttaHere% = -1
ELSE
PickedOne% = (TopRec% + HiLiteRow% - 1 <= LastFile%)
END IF
ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
' ^X or down arrow
IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastFile% THEN
HiliteRow% = HiliteRow% + 1
GOSUB DisplayFiles
ELSE
IF TopRec% + Rows% - 1 < LastFile% THEN
TopRec% = TopRec% + 1
GOSUB DisplayFiles
END IF
END IF
ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
' ^R or PgUp
IF TopRec% > Rows% THEN
TopRec% = TopRec% - Rows%
GOSUB DisplayFiles
ELSE
IF TopRec% > 1 THEN
TopRec% = 1
GOSUB DisplayFiles
END IF
END IF
ELSEIF AsciiCode% = 27 THEN
' <ESC>
LemmeOuttaHere% = -1
END IF
END IF
LOOP UNTIL PickedOne% OR LemmeOuttaHere%
IF PickedOne% THEN
FileSpec$ = RTRIM$(File(TopRec% + HiLiteRow% - 1).Arf)
ELSE
FileSpec$ = ""
END IF
'--- restore the screen
IF Mouse% THEN MMCursorOff
DSeg% = VARSEG(SavedScreen%(1))
DOfs% = VARPTR(SavedScreen%(1))
IF Shade% THEN
DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
ELSE
DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
END IF
IF Mouse% THEN MMCursorOn
IF Visible% THEN LOCATE , , 1
EXIT SUB
DisplayFiles:
IF Mouse% THEN MMCursorOff
IF LastFile% < 1 THEN
XQPrint "...no files...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
ELSE
' update scroll bar as needed
IF Rows% < LastFile% THEN
FOR Row% = TopRow% TO BottomRow%
XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
NEXT
IF TopRec% > 1 AND Rows% > 1 THEN
XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
END IF
IF TopRec% + Rows% - 1 < LastFile% AND Rows% > 0 THEN
XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
END IF
END IF
' update file list
FOR Row% = 1 TO Rows%
tmp% = TopRec% + Row% - 1
IF tmp% <= LastFile% THEN
St$ = " " + File(tmp%).Arf + " "
ELSE
St$ = SPACE$(14)
END IF
IF Row% = HiliteRow% THEN
XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
ELSE
XQPrint St$, TopRow% + Row% - 1, LeftCol%, FileListAttr%, Page%, Fast%
END IF
NEXT
END IF
IF Mouse% THEN MMCursorOn
RETURN
END SUB